home *** CD-ROM | disk | FTP | other *** search
/ PC World 2008 February / PCWorld_2008-02_cd.bin / domacnost a kancelar / move action / moveaction.exe / MailerThread.pas < prev    next >
Pascal/Delphi Source File  |  2007-12-04  |  4KB  |  134 lines
  1. {thread that runs in the background & emails any new JPG files it finds}
  2. unit MailerThread;
  3.  
  4. interface
  5.  
  6. uses
  7.   Classes, Windows, SysUtils, inifiles, NMsmtp,dialogs;
  8.  
  9. type
  10.   TMailer = class(TThread)
  11.   private
  12.    imageCount: integer;
  13.    emailto,emailfrom,emailsubject,emailbody,emailhost : string;
  14.    emailport : integer;
  15.    checkfileinterval: integer;
  16.   protected
  17.     procedure Execute; override;
  18.     procedure sendSMTPMessage(filename: string);
  19.     function LPad(s: String; nLength: integer): string ;
  20.   public
  21.     constructor create(IniFile: TIniFile; _imageCount: integer);
  22.     destructor destroy; override;
  23.   end;
  24.  
  25. implementation
  26.  
  27.  
  28.  
  29.  
  30. {constructor}
  31. constructor TMailer.create(IniFile: TIniFile; _imageCount: integer);
  32. begin
  33.    inherited create(true); // create but don't start running yet
  34.  
  35.    imageCount := _imageCount+1;
  36.    with IniFile do
  37.    begin
  38.       checkfileinterval := ReadInteger('main', 'email.checkfileinterval', 500);
  39.       emailto := ReadString('main', 'email.to', 'you@mycompany.com');
  40.       emailfrom := ReadString('main', 'email.from', 'me@mycompany.com');
  41.       emailsubject := ReadString('main', 'email.subject', 'Webcam image');
  42.       emailbody := ReadString('main', 'email.body', 'Webcam image was detected');
  43.       emailhost := ReadString('main', 'email.host', 'localhost');
  44.       emailport := ReadInteger('main', 'email.port', 25);
  45.    end;
  46. end;
  47.  
  48. {destructor}
  49. destructor TMailer.Destroy;
  50. begin
  51.    inherited destroy;
  52. end;
  53.  
  54.  
  55. {main thread entry point}
  56. procedure TMailer.Execute;
  57. var
  58.    filename: string;
  59. begin
  60.    // this thread looks for the next image file number, and mails it when found
  61.    repeat
  62.       filename := 'image_' + lpad(inttostr(imageCount), 6) + '.jpg';
  63.       if FileExists(filename) then
  64.       begin
  65.          sendSMTPMessage(filename);
  66.          inc(imageCount);
  67.       end
  68.       else
  69.       begin
  70.          sleep(checkfileinterval);
  71.       end;
  72.    until terminated;
  73.  
  74. end;
  75.  
  76. procedure TMailer.sendSMTPMessage(filename: string);
  77. var
  78.    smtp: TNMSMTP;
  79.    toAddress, body, attachments: TStringList;
  80. begin
  81.    // connect to the SMTP server, send a file and disconnect
  82.    // it would probably be more efficient to only make a single connection and send a whole bunch
  83.    // of files at once, but I'm not sure if some smtp servers will allow this, so I'm keeping it simple
  84.    try
  85.  
  86.       smtp := TNMSMTP.create(nil);
  87.       toAddress := TStringList.create;
  88.       body := TStringList.create;
  89.       attachments := TStringList.create;
  90.       try
  91.          with smtp do
  92.          begin
  93.             host := emailhost;
  94.             port := emailport;
  95.             timeout := 60000;
  96.             with PostMessage do
  97.             begin
  98.                body.add(emailbody);
  99.                subject := emailsubject + ' - ' + filename;
  100.                toAddress.add(emailto);
  101.                fromName := emailfrom;
  102.                fromAddress := emailfrom;
  103.                replyto := emailfrom;
  104.                attachments.add(filename);
  105.             end;
  106.             connect;
  107.             sendMail;
  108.             disconnect;
  109.          end;
  110.       finally
  111.          attachments.free;
  112.          toAddress.free;
  113.          body.free;
  114.          smtp.free;
  115.       end;
  116.  
  117.    except
  118.       on e:exception do
  119.       begin
  120.          // zoinks - now what?  we don't have a log or console...leave this to you to modify!
  121.       end;
  122.    end;
  123. end;
  124.  
  125. {left-pads a string}
  126. function TMailer.LPad(s: String; nLength: integer): string ;
  127. begin
  128.    while length(s) < nLength do
  129.       s := '0' + s ;
  130.    result := s ;
  131. end ;
  132.  
  133. end.
  134.